home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / prolog_2.zip / CHART.ZIP / CHART.PRO next >
Text File  |  1987-04-03  |  31KB  |  747 lines
  1.  
  2. /* Note from Bob:
  3.  
  4. 1) Load chart.pro
  5. 2) Load test01.pro or test02.pro
  6. 3) Try the "p" and "m" goals below, which I have inserted: 
  7. 4) Buy the book this guy recommends and read your ass off.
  8.  
  9. */
  10.  
  11. /* For PD and ED PROLOG, define member: */
  12.  
  13. member( X, [X|_] ).
  14. member( X, [_|T] ) :- member( X, T ).
  15.  
  16. /* For FS and higher versions, be sure to comment out above 
  17. definition. */
  18.  
  19. p :- 
  20.     parse( trial, [the,a,man,women,park,telescope,in,with,
  21.                     saw, likes], MaxVertex, Chart ),
  22.     print('\nMaxVertex: ', MaxVertex ),
  23.     print('\nChart:     ', Chart ).
  24.  
  25. m :- 
  26.     make_chart( trial, [the,a,man,women,park,telescope,in,with,
  27.                     saw, likes], MaxVertex, Chart ),
  28.     print('\nMaxVertex: ', MaxVertex ),
  29.     print('\nChart:     ', Chart ).
  30.  
  31.  
  32.  
  33. /* Answer the questions: td.<CR> and df.<CR> 
  34.    (top down and depth first). Don't delete the periods!. */
  35.  
  36.  
  37.  
  38. /*
  39.  File:         chart.pro
  40.  Author:       Peter Ross
  41.  Updated:      25 March 1986 (added stop-parser/6)
  42.  Purpose:      simple general purpose active chart parser
  43.  
  44.  This is a (very) simple general purpose chart parser.
  45.  There is separate user documentation in "chart.txt".
  46.  
  47.  There are three important data structures to know about:
  48.  Edge:
  49.        edge(Category, Found, Needs, StartVertex, EndVertex)
  50.                Category is the category as on the LHS of a rule.
  51.                Found is what has already been accounted for, of the
  52.                    RHS of that rule. At the start it is just []. It
  53.                    is ordered so that the most recently found item is
  54.                    first. To help analyse the chart after the parseing,
  55.                    the items are of the form
  56.                        Category = VertexNumber
  57.                    showing the vertex number where that found category
  58.                    started.
  59.                Needs is what has not yet been accounted for, of the
  60.                    RHS of that rule. At the start it is everything.
  61.                Startvertex and EndVertex show where the edge is.
  62.        NOTES: [1] Found and Needs don't get changed. New edges with updated
  63.                   Found (bigger) and Needs (smaller) get added.
  64.               [2] when applying the Fundamental Rule, assume that the new
  65.                   edge goes farther right than the active edge that gave
  66.                   birth to it, as opposed to farther left.
  67.               [3] a reminder: an edge is ACTIVE is Needs is non-empty.
  68.                   Otherwise it is INACTIVE.
  69.               [4] Found lists are really just bureaucracy useful when the
  70.                   parsing is done.
  71.  Chart:
  72.        ActiveEdgeList + InactiveEdgeList
  73.                The two types of edges are kept in separate lists for
  74.                convenience. Only edges which have been processed already
  75.                (so that they have triggered all the new edges they can)
  76.                get onto the chart.
  77.  Agenda:
  78.        CandidateList - Hole
  79.                This is a difference list (a list with a hole at the end, so
  80.                it's as cheap to add items at the end, when working
  81.                breadth-first, as to add items to the front, when working
  82.                depth-first). The items are all of the form
  83.                        ActiveEdge+InactiveEdge
  84.                and the fundamental rule is in due course applied to each
  85.                such pair of edges. In fact, the way the code works, the
  86.                rule is guaranteed to succeed, although the user could modify
  87.                the test of candidacy, and the fundamental rule, so that it
  88.                did not always work. As things stand, we could apply the rule
  89.                before the item ever gets onto the agenda, but that would
  90.                tend to hide the algorithm even more, and cut down the general
  91.                flexibility. The speed loss is pretty trivial.
  92.  
  93.  The Fundamental Rule is:
  94.        Find a case of an ACTIVE edge meeting, at its EndVertex, the
  95.        StartVertex of an INACTIVE edge, such that the category of the
  96.        INACTIVE edge is what is first needed for the ACTIVE edge to
  97.        'grow'. Construct a new edge from these two:
  98.                - its category will be that of the ACTIVE edge.
  99.                - the Found list is the Found list of the ACTIVE edge
  100.                  but with the category of the INACTIVE edge added.
  101.                - the Needs list is the tail of the Needs list of the
  102.                  ACTIVE edge.
  103.                - the edge spans both the old edges.
  104.  You could always modify this rule, e.g. for plan recognition purposes allow
  105.  there to be a gap between the end of the active edge and the start of the
  106.  inactive edge.
  107.  
  108.  Certain decisions are needed. Does parsing start with the most global
  109.  category and proceed downward ("top-down") or with the minimal chart
  110.  built from the raw data and the input, and proceed upward ("bottom-up")?
  111.  Either way, there will be an agenda of candidates for applying the
  112.  fundamental rule. When the first candidate on the agenda is processed,
  113.  more candidates will arise from that. Should they go on the front of
  114.  the agenda ("depth-first") or the end ("breadth-first"), or should the
  115.  user be allowed to reshuffle the agenda as he likes. The code does not
  116.  currently cater for this last choice, and would need a bit of hacking
  117.  to make it do so. Chief point is that currently the agenda is a difference
  118.  list, so it is cheap to add things to either end, but is no better than
  119.  an ordinary list if you want to start adding things to the middle.
  120.  (Note for future hackers: how about keeping the agenda as a tree, with
  121.  the user's sorting relation defined as the tree ordering relation? More
  122.  costly than the simple scheme here, but about equally good for any sensible
  123.  (i.e. non-global) ordering rule...)
  124.  
  125.  
  126.  ================== START OF THE CODE ==================
  127.  
  128.  ======== TOP LEVEL ========
  129.  
  130.  parse/4: the TOP-LEVEL goal of all this lot. Use make_chart/4 if the
  131.        rules have already been inverted.
  132.  
  133. */
  134.  
  135. ?-op( 254, xfy, '->' ).
  136. (X -> Y; Z) :- X, !, Y.
  137. (X -> Y; Z) :- Z.
  138. prompt( _, X ) :- print( '\n', X ).
  139.  
  140.  
  141.  
  142. parse(Tag, WordList, MaxVertex, Chart) :-
  143.         invert_rules(Tag),
  144.         make_chart(Tag, WordList, MaxVertex, Chart).
  145.  
  146. /*
  147.  invert_rules/1: takes a tag. Looks at each rule, adds clauses of the form
  148.                upward_rule(Tag, Category, [Parent=[Category|Rest], ...])
  149.        and
  150.                downward_rule(Tag, Category, ListOfExpansions)
  151.        purely for "speed" later on. The point is that the system
  152.        want to find, in bottom-up search, all rules with a given
  153.        category as the first item on the RHS (upward_rule/3 gives
  154.        this) or, in top-down search, all rules with a given LHS
  155.        (downward_rule/3 does this). This "rule inversion" should
  156.        be done once only, not once per parse, since all the necessary
  157.        information is contained in the rule/3 clauses.
  158.        Yes, it is a bit cumbersome, and sorry about those failure-driven
  159.        loops.
  160. */
  161.  
  162. invert_rules(Tag) :-
  163.         abolish(upward_rule,3),
  164.         rule(Tag, _, [Category|_]),
  165.         not(upward_rule(Tag,Category,_)),
  166.         setof(Parent=[Category|Rest],
  167.               rule(Tag,Parent,[Category|Rest]),
  168.               List),
  169.         assert(upward_rule(Tag, Category, List)),
  170.         fail.
  171. invert_rules(Tag) :-
  172.         abolish(downward_rule,3),
  173.         rule(Tag, Category,_),
  174.         not(downward_rule(Tag,Category,_)),
  175.         setof(RHS,
  176.               rule(Tag,Category,RHS),
  177.               List),
  178.         assert(downward_rule(Tag,Category,List)),
  179.         fail.
  180. invert_rules(Tag) :-
  181.         ( watching(Tag) ->
  182.                 write('inverse rules created for tag '),
  183.                 write(Tag), nl
  184.         ; true
  185.         ).
  186.  
  187. /*
  188.  make_chart/4: given tag, a WordList, produce the maximum vertex number and
  189.        a final chart. The approach is one that reflects my undersatnding
  190.        of what ought to be happening in a simple chart parser, namely:
  191.            (a) pick up the strategy and policy:
  192.                strategies: bu = bottom up, namely try rule expansions
  193.                                 triggered by inactive edge creation
  194.                            td = top down, namely try rule expansions
  195.                                 triggered by active edge creation
  196.                policies:   df = depth first, namely add new candidates
  197.                                 to front of agenda lists
  198.                            bf = breadth first, namely add new candidates
  199.                                 to back of agenda lists
  200.            (b) grow an initial chart using all the words and all the lexical
  201.                info to get the lowest level details. Any active edges will
  202.                be added according to the strategy, i.e. if bottom-up then
  203.                each inactive edge will trigger rule expansion upward and
  204.                cause some active edges to be added. If top-down, only
  205.                one active edge will initially be added, but this will
  206.                trigger the addition of some more active edges. To make
  207.                life easy for the initialisation routines, and to help
  208.                whoever looks at the chart afterward to spot what the
  209.                top-level category was, there is an assumed ersatz rule
  210.                of the form
  211.                        user -> top_level_category.
  212.                Thus you can look for the edge
  213.                        edge(user,[],[Top],0,0)
  214.                to spot the topmost category. This will be useful when I
  215.                get round to adding rule tags, when there will be many top
  216.                categories, but only one such edge per chart - so you can
  217.                deduce the tag backwards. The penalty is, of course, that
  218.                you shouldn't have a category called 'user'. If you really
  219.                want to, you will need to have a predicate
  220.                        ersatz_category(Tag, ErsatzCategoryName)
  221.                and then the system will use that name instead.
  222.            (c) grow the initial agenda (strategy-dependent)
  223.            (d) call chart/5 to run the main loop and check for termination.
  224. */
  225.  
  226. make_chart(T, WordList, MaxVertex, FinalChart) :-
  227.         strategy(T,S),     /* choices: bu or td, validated higher up. */
  228.         policy(T,P),       /* choices: df or bf, validated higher up. */
  229.         ( watching(T) ->
  230.                 prompt(_, 'monitor:')
  231.         ; true
  232.         ),
  233.         initial_setup(T,S,P, WordList, 0, MaxVertex,
  234.                       []+[], InitialChart,
  235.                       Var-Var,InitialAgenda),
  236.         chart(T,S,P, InitialChart, InitialAgenda, FinalChart).
  237.  
  238. /*
  239.  chart/6: the main loop (with monitoring hook). Given tag, strategy, policy,
  240.        the current chart and agenda, work out the final chart.
  241.        This encapsulates the basic control algorithm of a chart parser,
  242.        namely:
  243.                - get the first entry of the agenda. This is a pair of
  244.                  edges to which the fundamental rule applies.
  245.                - apply the fundamental rule to get a new edge.
  246.                - add this edge to the chart. This includes the job of
  247.                  finding any inactive edges with which it will
  248.                  eventually combine at a later cycle. Add items to the
  249.                  agenda for each such case (at the back if breadth-first,
  250.                  at the front if depth-first).
  251.                  Also, if we are working top-down, then adding an active
  252.                  edge will recursively trigger the addition of further
  253.                  active 'embryo' edges according to the rule clauses.
  254.                  If we are working bottom-up, this triggering is done
  255.                  when inactive edges are added.
  256. */
  257.  
  258. chart(T,S,P, Chart, Agenda, FinalChart) :-
  259.         stop_parser(T,S,P,Chart,Agenda,FinalChart),
  260.         !.
  261. chart(T,S,P, Chart, [AEdge+IEdge|Rest]-Var, FinalChart) :-
  262.         apply_fr(AEdge,IEdge,NewEdge),
  263.         ( active(NewEdge) ->
  264.             add_active_edge(T,S,P,NewEdge,Chart,NewChart,Rest-Var,NewAgenda)
  265.         ; add_inactive_edge(T,S,P,NewEdge,Chart,NewChart,Rest-Var,NewAgenda)
  266.         ),
  267.         monitor(T,S,P,Chart,[AEdge+IEdge|Rest]-Var,NewChart,NewAgenda),
  268.         chart(T,S,P,NewChart,NewAgenda,FinalChart).
  269.  
  270. /*
  271.  ============ SUBSIDIARY PREDICATES ============
  272.  
  273.  ======== INITIALISING STUFF ========
  274.  
  275.  initial_setup/9: given tag, strategy, policy, word list, min vertex,
  276.        return number giving the maximum vertex number, and from a seed chart
  277.        (typically []+[] if not re-starting) create an initial chart and
  278.        from a seed agenda (typically Var-Var if not-restarting) create
  279.        an initial agenda.
  280. */
  281.  
  282. initial_setup(T,S,P, WordList, MinVertex, MaxVertex,
  283.               SeedChart, InitialChart,
  284.               SeedAgenda, InitialAgenda) :-
  285.         words_to_edges(T, WordList, MinVertex, MaxVertex, EdgeList),
  286.         add_inactive_list(T,S,P,EdgeList,SeedChart,TempChart,
  287.                           SeedAgenda,TempAgenda),
  288.         initial_category(T, C),
  289.         (ersatz_category(T, EC)
  290.         ; EC = user
  291.         ),
  292.         !,
  293.         add_active_edge(T,S,P,edge(EC,[],[C],MinVertex,MinVertex),
  294.                         TempChart,InitialChart,
  295.                         TempAgenda,InitialAgenda).
  296.  
  297. /*
  298.  words_to_edges/5: given tag, word list, min vertex number, return maximum
  299.        vertex number (for later use in inspecting final chart) and list of
  300.        inactive edges derived from lexical data about each word.
  301. */
  302.  
  303. words_to_edges(T, WordList, MinVertex, MaxVertex, EdgeList) :-
  304.         words_to_edges(T, WordList, MinVertex, MaxVertex, [], EdgeList).
  305.  
  306. words_to_edges(_, [], N, N, Answer, Answer).
  307. words_to_edges(T, [W|More], N, MaxVertex, List, Answer) :-
  308.         !,
  309.         ( lexical(T,W,Categories) ->
  310.                 true
  311.         ; write('Word '),
  312.           write(W),
  313.           write(' has no entry in the lexicon for tag '),
  314.           write(T),
  315.           write(' - skipped it'),
  316.           nl,
  317.           Categories = []
  318.         ),
  319.         N1 is N+1,
  320.         cats_to_edges(Categories,W,N,N1,List,NewList),
  321.         words_to_edges(T,More,N1,MaxVertex,NewList,Answer).
  322.  
  323. cats_to_edges([],_,_,_,List,List).
  324. cats_to_edges([C|More],W,N,N1,List,Answer) :-
  325.         cats_to_edges(More,W,N,N1,[edge(C,[word(W)=N],[],N,N1)|List],Answer).
  326.  
  327. /*
  328.  add_inactive_list/8: given tag, strategy, policy, list of inactive edges,
  329.        old chart, get new chart, given old agenda, get new agenda. This is
  330.        done by adding each inactive edge in turn.
  331. */
  332.  
  333. add_inactive_list(T,S,P,[E|More],Chart,NewChart,Agenda,NewAgenda) :-
  334.         !,
  335.         add_inactive_edge(T,S,P,E,Chart,MidChart,Agenda,MidAgenda),
  336.         add_inactive_list(T,S,P,More,MidChart,NewChart,MidAgenda,NewAgenda).
  337. add_inactive_list(_,_,_,_,Chart,Chart,Agenda,Agenda).
  338.  
  339. /*
  340.  ======== SUBSIDIARY PREDICATES FOR THE MAIN PART ========
  341.  
  342.  add_active_edge/8: arguments are tag, strategy, policy, edge (active), old
  343.        chart, resulting new chart, old agenda, resulting new agenda.
  344.        Much depends on the strategy. If it is top-down (td), then whenever
  345.        an active edge is added and it is possible to add new embryo edges,
  346.        then add them - each will recursively add more embryo active edges.
  347.        If the strategy is bottom-up, new embryo edges are not sought.
  348.        Either way, if an active edge is added, then all pairings with
  349.        inactive edges that the fundamental rule might apply to are added
  350.        to the agenda.
  351. */
  352.  
  353. add_active_edge(_,td,_,Edge,OldA+OldI,OldA+OldI,OldAg-OldV,OldAg-OldV) :-
  354.         Edge = edge(C,[],N,V,V),           /* Is this an empty active edge?*/
  355.         member(edge(C1,[],N1,V,V), OldA),  /*If so, look for similar,*/
  356.         equiv_terms(C1,C,[],PartSubst),    /*.. test for equivalence without*/
  357.         equiv_terms(N1,N,PartSubst,_),     /*any unification. If found,*/
  358.         !.                                 /*don't add a duplicate edge.*/
  359. add_active_edge(T,td,P,Edge,OldA+OldI,NewA+OldI,OldAg-OldV,NewAg-NewV) :-
  360.         Edge = edge(_,_,[N|_],_,EV),
  361.         downward_edge_list(T,N,EV,EdgeList),
  362.         !,                       /*Aha ... there are relevant rules!*/
  363.         add_active_configs(P,Edge,OldI,OldAg-OldV,MidAg-MidV),
  364.         add_active_list(T,td,P,EdgeList,[Edge|OldA]+OldI,NewA+OldI,MidAg-MidV,
  365.                         NewAg-NewV).
  366. add_active_edge(_,_,P,Edge,OldA+OldI,[Edge|OldA]+OldI,OldAg-OldV,NewAg-NewV) :-
  367.         add_active_configs(P,Edge,OldI,OldAg-OldV,NewAg-NewV).
  368.  
  369. /* add_active_configs/5: given policy, new edge, list of inactive edges, old
  370.        agenda, then creates a new agenda by adding all possible
  371.        configurations to the agenda and returning the new agenda. */
  372.  
  373. add_active_configs(df,
  374.                    ActiveEdge,
  375.                    [InactiveEdge|MoreIs],
  376.                    OldAg-OldV,
  377.                    NewAg-OldV) :-
  378.         candidate(ActiveEdge,InactiveEdge),
  379.         !,
  380.         MidAg = [ActiveEdge+InactiveEdge|OldAg],
  381.         add_active_configs(df,
  382.                            ActiveEdge,
  383.                            MoreIs,
  384.                            MidAg-OldV,
  385.                            NewAg-OldV).
  386. add_active_configs(bf,
  387.                    ActiveEdge,
  388.                    [InactiveEdge|MoreIs],
  389.                    OldAg-OldV,
  390.                    OldAg-NewV) :-
  391.         candidate(ActiveEdge,InactiveEdge),
  392.         !,
  393.         OldV = [ActiveEdge+InactiveEdge|MidV],
  394.         add_active_configs(bf,
  395.                            ActiveEdge,
  396.                            MoreIs,
  397.                            OldAg-MidV,
  398.                            OldAg-NewV).
  399. add_active_configs(P,
  400.                    ActiveEdge,
  401.                    [_|MoreIs],
  402.                    OldAg-OldV,
  403.                    NewAg-NewV) :-
  404.         add_active_configs(P,
  405.                            ActiveEdge,
  406.                            MoreIs,
  407.                            OldAg-OldV,
  408.                            NewAg-NewV).
  409. add_active_configs(_,_,[],Ag-V,Ag-V).
  410.  
  411. /*
  412.  add_inactive_edge/8: arguments are tag, strategy, policy, edge (inactive),
  413.        old chart, resulting new chart, old agenda, resulting new agenda.
  414.        Much depends on the strategy. If it is bottom-up (bu), then whenever
  415.        an inactive edge is added and it is possible to add new embryo edges,
  416.        then add them - these will be active, of course.
  417.        If the strategy is top-down, new embryo edges are not sought.
  418.        Either way, if an inactive edge is added, then all pairings with
  419.        active edges that the fundamental rule might apply to are added
  420.        to the agenda.
  421.  
  422.  NB: normally, there is no need to check whether an inactive edge is new -
  423.  it will be, because duplication would have been caught at the active edge
  424.  which started it off. However, in this parser, it is possible to halt
  425.  parsing and change the rule tag, so causing new parse rules to be brought
  426.  in in the middle of parsing (horrible, yes, but may offer mileage in the
  427.  control of parsing when you want to do a less than exhaustive job).
  428.  So, at present, the next clause is commented out. Restore it if you really
  429.  have a need for it and can bear the overhead it imposes.
  430. */
  431.  
  432.  add_inactive_edge(_,bu,_,Edge,A+OldI,A+OldI,OldAg-OldV,OldAg-OldV) :-
  433.        Edge = edge(C,F,[],SV,EV),          /*If it's inactive,*/
  434.        member(edge(C1,F1,[],SV,EV),OldI),  /*find anything similar,*/
  435.        equiv_terms(C1,C,[],PartSubst),     /*then check for exact equivalence*/
  436.        equiv_terms(F1,F,PartSubst,_),      /*in order to avoid adding a*/
  437.        !.                                  /*duplicate edge.*/
  438. add_inactive_edge(T,bu,P,Edge,A+OldI,NewA+[Edge|OldI],OldAg-OldV,NewAg-NewV) :-
  439.         Edge = edge(Cat,_,[],SV,_),
  440.         upward_edge_list(T,Cat,SV,EdgeList),
  441.         !,                       /*Aha ... there are relevant rules!*/
  442.         add_inactive_configs(P,Edge,A,OldAg-OldV,MidAg-MidV),
  443.         add_active_list(T,td,P,EdgeList,A+[Edge|OldI],NewA+[Edge|OldI],
  444.                         MidAg-MidV, NewAg-NewV).
  445. add_inactive_edge(_,_,P,Edge,A+OldI,A+[Edge|OldI],OldAg-OldV,NewAg-NewV) :-
  446.         add_inactive_configs(P,Edge,A,OldAg-OldV,NewAg-NewV).
  447. /*
  448.  add_inactive_configs/5: given policy, new edge, list of active edges, old
  449.        agenda, then creates a new agenda by adding all possible
  450.        configurations to the agenda and returning the new agenda.
  451. */
  452.  
  453. add_inactive_configs(df,
  454.                    InactiveEdge,
  455.                    [ActiveEdge|MoreAs],
  456.                    OldAg-OldV,
  457.                    NewAg-OldV) :-
  458.         candidate(ActiveEdge,InactiveEdge),
  459.         !,
  460.         MidAg = [ActiveEdge+InactiveEdge|OldAg],
  461.         add_inactive_configs(df,
  462.                            InactiveEdge,
  463.                            MoreAs,
  464.                            MidAg-OldV,
  465.                            NewAg-OldV).
  466. add_inactive_configs(bf,
  467.                    InactiveEdge,
  468.                    [ActiveEdge|MoreAs],
  469.                    OldAg-OldV,
  470.                    OldAg-NewV) :-
  471.         candidate(ActiveEdge,InactiveEdge),
  472.         !,
  473.         OldV = [ActiveEdge+InactiveEdge|MidV],
  474.         add_inactive_configs(bf,
  475.                            InactiveEdge,
  476.                            MoreAs,
  477.                            OldAg-MidV,
  478.                            OldAg-NewV).
  479. add_inactive_configs(P,
  480.                    InactiveEdge,
  481.                    [_|MoreAs],
  482.                    OldAg-OldV,
  483.                    NewAg-NewV) :-
  484.         add_inactive_configs(P,
  485.                            InactiveEdge,
  486.                            MoreAs,
  487.                            OldAg-OldV,
  488.                            NewAg-NewV).
  489. add_inactive_configs(_,_,[],Ag-V,Ag-V).
  490.  
  491. /* add_active_list/8: like add_active_edge/8, but works through a list
  492.        of active edges.  */
  493.  
  494. add_active_list(T,S,P,[Edge|Rest],OldA+I,NewA+I,OldAg-OldV,NewAg-NewV) :-
  495.         !,
  496.         add_active_edge(T,S,P,Edge,OldA+I,MidA+I,OldAg-OldV,MidAg-MidV),
  497.         add_active_list(T,S,P,Rest,MidA+I,NewA+I,MidAg-MidV,NewAg-NewV).
  498. add_active_list(_,_,_,[],A+I,A+I,Ag-V,Ag-V).
  499.  
  500. /* downward_edge_list/4: given a tag, a category and a vertex, make up a list
  501.        of all the embryo edges extractable from the downward_rule/3 for that
  502.        category.*/
  503.  
  504. downward_edge_list(T,Cat,Vertex,EdgeList) :-
  505.         downward_rule(T,Cat,RHSlist),
  506.         rhs_to_edge_list(Cat,Vertex,RHSlist,EdgeList).
  507.  
  508. rhs_to_edge_list(Cat,V,[RHS|More],[edge(Cat,[],RHS,V,V)|Rest]) :-
  509.         !,
  510.         rhs_to_edge_list(Cat,V,More,Rest).
  511. rhs_to_edge_list(_,_,[],[]).
  512.  
  513. /* upward_edge_list/4: given a tag, a category and a vertex, make up a list of
  514.        all the embryo edges extractable from the upward_rule/3 for that
  515.        category. */
  516.  
  517. upward_edge_list(T,Cat,Vertex,EdgeList) :-
  518.         upward_rule(T,Cat,RuleList),
  519.         rule_to_edge_list(RuleList,Vertex,EdgeList).
  520.  
  521. rule_to_edge_list([Parent=RHS|More],V,[edge(Parent,[],RHS,V,V)|Rest]) :-
  522.         !,
  523.         rule_to_edge_list(More,V,Rest).
  524. rule_to_edge_list([],_,[]).
  525.  
  526. /*
  527.  unify_terms/4: takes two terms, constructs as third argument
  528.        the term that would have resulted if they had been unified (but
  529.        they aren't unified by this procedure). Also returns as fourth
  530.        argument a list of the variable->variable substitutions made,
  531.        for possible later use. The substitutions are recorded in the
  532.        form NewVariable=OldVariable.
  533.        This predicate is used to ensure that edges stay independent.
  534.        By ensuring that edge pairs only get on the agenda if they can
  535.        definitely create a new edge, there is a guarantee that this
  536.        moderately expensive predicate only gets applied to terms which
  537.        could unify.
  538. */
  539.  
  540. unify_terms(Term1, Term2, Result, FinalSubstitution) :-
  541.         copy_term(Term1, Copy1, [], PartSubstitution),
  542.         copy_term(Term2, Copy2, PartSubstitution, FinalSubstitution),
  543.         Result = Copy1,
  544.         Result = Copy2.
  545.  
  546. copy_term(Term, Copy, SubstSoFar, FinalSubst) :-
  547.         var(Term), !,
  548.         subst_member(SubstSoFar, Term, Copy, FinalSubst).
  549. copy_term(Term, Copy, SubstSoFar, FinalSubst) :-
  550.         functor(Term, Functor, Arity),
  551.         functor(Copy, Functor, Arity),
  552.         copy_term(Arity, Term, Copy, SubstSoFar, FinalSubst).
  553.  
  554. copy_term(0, Term, Copy, SubstSoFar, SubstSoFar) :- !.
  555. copy_term(N, Term, Copy, SubstSoFar, FinalSubst) :-
  556.         arg(N, Term, TermN),
  557.         copy_term(TermN, CopyN, SubstSoFar, FurtherSubst),
  558.         arg(N, Copy, CopyN),
  559.         succ(M, N), !,
  560.         copy_term(M, Term, Copy, FurtherSubst, FinalSubst).
  561.  
  562. subst_member(Subst, Term, Copy, Subst) :-
  563.         subst_member(Subst, Term, Copy), !.
  564. subst_member(Subst, Term, Copy, [Copy = Term|Subst]).
  565.  
  566. subst_member([New = Old|_], Term, Copy) :-
  567.         Old == Term,
  568.         !,
  569.         New = Copy.
  570. subst_member([_|Rest], Term, Copy) :-
  571.         subst_member(Rest, Term, Copy).
  572.  
  573. /*
  574.  equiv_terms/4: checks whether two terms are precisely equivalent in
  575.        structure, modulo change of variables. This is much narrower
  576.        than checking whether they could be unified, and is only used
  577.        in the parser recursion checks. Since this test involves structure
  578.        smashing, so ain't cheap, it is only applied after weaker tests
  579.        have dug up likely equivalences.
  580. */
  581.  
  582. equiv_terms(T1, T2, Subst, NewSubst) :-
  583.         var(T1),
  584.         !,
  585.         var(T2),
  586.         ( subst_member(Subst, T1, T3) ->
  587.                 T3 == T2,
  588.                 NewSubst = Subst
  589.         ;       NewSubst = [T2=T1|Subst]
  590.         ).
  591. equiv_terms(T1, T2, Subst, FinalSubst) :-
  592.         functor(T1, F, N),
  593.         functor(T2, F, N),
  594.         equiv_terms(N, T1, T2, Subst, FinalSubst).
  595.  
  596. equiv_terms(0, _, _, S, S).
  597. equiv_terms(N, T1, T2, Subst, FinalSubst) :-
  598.         arg(N, T1, A1),
  599.         arg(N, T2, A2),
  600.         equiv_terms(A1, A2, Subst, MidSubst),
  601.         succ(M,N),
  602.         !,
  603.         equiv_terms(M, T1, T2, MidSubst, FinalSubst).
  604.  
  605. /*
  606.  ======== USER-REDEFINABLE PREDICATES ========
  607.  
  608.  NOTE: do NOT change the format of an edge, it is explicitly used in
  609.        several other places in the code. These definitions are grouped
  610.        here for convenience. Together they define the essence of the
  611.        fundamental rule.
  612.  
  613.  active/1: succeeds if its argument is an active edge. In the system, an
  614.        edge is inactive if it is not active.
  615. */
  616.  
  617. active(edge(_,_,[_|_],_,_)).
  618.  
  619. /*
  620.  candidate/2: takes two edges, succeeds if they are candidates for
  621.        application of the fundamental rule. In normal chart parsing,
  622.        this test is so simple it is silly to have it wrapped up in a
  623.        separate predicate like this. However, having it separate makes it
  624.        easy to change. Note that the first edge must be active and the
  625.        second edge must be inactive. This is dictated by the places where
  626.        this predicate is used.
  627.        Note that the clause checks whether two categories are unifiable,
  628.        but it must not actually unify them. Variables mentioned in the
  629.        category structures must stay as such.
  630. */
  631.  
  632. /*
  633. candidate(edge(_,_,[N1|_],_,V), edge(N2,_,_,V,_)) :-
  634.         \+(\+(N1=N2)).
  635. */
  636.  
  637. candidate(edge(_,_,[N1|_],_,V), edge(N2,_,_,V,_)) :-
  638.         not(not(N1=N2)).
  639.  
  640.  
  641. /* apply_fr/3: applies the fundamental rule to a given active and a given
  642.        inactive edge. Returns a new edge. */
  643.  
  644. apply_fr(edge(C,F,[N1|Rest],SV,MV),
  645.          edge(N2,_,_,MV,EV),
  646.          edge(D,[N3=MV|F],NewRest,SV,EV)) :-
  647.          unify_terms(N1,N2,N3,Subst),
  648.          copy_term(C, D, Subst, NewSubst),
  649.          copy_term(Rest, NewRest, NewSubst, _).
  650.  
  651. /* stop_parser/6: takes the same arguments as chart/6, succeeds if and only
  652.        if it is time to stop (or pause) parsing. In most cases the stop
  653.        condition you want is the one given here, namely you've run out
  654.        of agenda. The final argument is the final chart returned to the
  655.        caller by the parser. */
  656.  
  657. stop_parser(_,_,_,Chart,Ag-_,Chart) :-
  658.         var(Ag).
  659.  
  660. /*
  661.  ============ MONITORING TOOLS ============
  662.  
  663.  monitor/7: hook for the user to watch what is going on. The
  664.        user must have turned on 'watching' by using watch/1
  665.        (converse nowatch/1) first. He can define user_mon/7
  666.        for himself: the arguments are
  667.                - tag to identify the rule set
  668.                - strategy
  669.                - policy
  670.                - old chart
  671.                - old agenda
  672.                - new chart
  673.                - new agenda
  674.        All are instantiated already. user_mon/7 might, for
  675.        example, show changes between old and new, just show the
  676.        old versions, or be sophisticated and ask the user what
  677.        he wants to see.
  678.  
  679.        If user_mon/7 fails, and watching is turned on, the user will
  680.        get the default scheme - the old chart and agenda will be
  681.        written on the output, and the monitor will wait for the user
  682.        to type <cr> before continuing.
  683. */
  684.  
  685.  
  686. monitor(T,S,P,OC,OA,NC,NA) :-
  687.         watching(T),
  688.         user_mon(T,S,P,OC,OA,NC,NA),
  689.         !.
  690. monitor(T,_,_,_,_,NC,NA) :-
  691.         watching(T),
  692.         write('Chart:  '),write(NC),nl,nl,
  693.         write('Agenda: '),write(NA),nl,nl,
  694.         skip(10),
  695.         !.
  696. monitor(_,_,_,_,_,_,_).
  697.  
  698. watch(T) :-
  699.         ( watching(T)
  700.         ; assert(watching(T))
  701.         ).
  702. nowatch(T) :-
  703.         ( retract(watching(T))
  704.         ; true
  705.         ).
  706.  
  707. print_chart(A+I) :-
  708.         sort(A,SortedA),
  709.         sort(I,SortedI),
  710.         print_sorted_chart(SortedA+SortedI).
  711.  
  712. print_sorted_chart([A|MoreA]+[I|MoreI]) :-
  713.         write('  Active edges: '),
  714.         write(A), nl,
  715.         print_list(MoreA,16),
  716.         write('Inactive edges: '),
  717.         write(I), nl,
  718.         print_list(MoreI,16).
  719.  
  720. print_list([],_).
  721. print_list([Item|Rest],N) :-
  722.         tab(N), write(Item), nl,
  723.         print_list(Rest,N).
  724.  
  725. /* A simple test rig: */
  726.  
  727. test(T) :-
  728.         ( upward_rule(T,_,_)
  729.         ; downward_rule(T,_,_)
  730.         ; write('Inverting rules for tag '), write(T), nl,
  731.           invert_rules(T),
  732.           write('...done the inversion'), nl
  733.         ),
  734.         !,
  735.         prompt(_, 'Word list: '),
  736.         read(L),
  737.         ( L = [_|_]
  738.         ; write('sorry, your input must be a list - try again'), nl
  739.         ),
  740.         !,
  741.         make_chart(T,L,_,C),
  742.         nl,
  743.         print_chart(C).
  744.  
  745.  
  746.  
  747.